home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / DeHQX-200-Source / HQXLists.p < prev    next >
Encoding:
Text File  |  1991-08-23  |  3.8 KB  |  179 lines  |  [TEXT/PJMM]
  1. unit HQXLists;
  2. { DeHQX v2.0.0 © Peter Lewis, Aug 1991 }
  3.  
  4. interface
  5.  
  6.     uses
  7.         MyLists, MyFileSystem;
  8.  
  9.     var
  10. { Total size in all lists.  Set to zero in InitHQXLists.  size added in AddFile. }
  11.         size_in_lists: longInt;
  12. { Total size in all processed files.  Set to zero in InitHQXLists.  You add any processed bytes }
  13.         size_processed: longInt;
  14. { Current name being processed }
  15.         processing_name: str63;
  16.  
  17.     procedure InitHQXLists;
  18.     procedure AddFile (vrn: integer; dirID: longInt; name: str63; folder: boolean; size: longInt);
  19.     function AnyInputFiles: boolean;
  20.     procedure StartList;
  21.     function AnyFilesLeft: boolean;
  22.     procedure GetNextFile (var vrn: integer; var dirID: longInt; var name: str63; var folder: boolean);
  23.     procedure FinishFile (del: boolean);
  24.     procedure FinishList (del: boolean);
  25.     procedure FinishHQXLists;
  26.  
  27. implementation
  28.  
  29.     type
  30.         fileList = record
  31.                 Fvrn: integer;
  32.                 FdirID: longInt;
  33.                 Fsh: stringHandle;
  34.                 Ffolder: boolean;
  35.                 Fdel: boolean;
  36.                 Fsize: longInt;
  37.             end;
  38.         fileListPtr = ^fileList;
  39.         fileListHandle = ^fileListptr;
  40.  
  41.     var
  42.         inlist, outlist: listHead;
  43.         outptr: listItem;
  44.         outflh: fileListHandle;
  45.  
  46.     procedure InitHQXLists;
  47.     begin
  48.         CreateList(inlist);
  49.         CreateList(outlist);
  50.         size_in_lists := 0;
  51.         size_processed := 0;
  52.         processing_name := '';
  53.     end;
  54.  
  55.     procedure DeleteList (var lh: listHead; del: boolean);
  56.         var
  57.             flh: fileListHandle;
  58.             ooe: OSErr;
  59.     begin
  60.         while not IsEmpty(lh) do begin
  61.             DeleteHead(lh, flh);
  62.             if del and flh^^.Fdel then
  63.                 ooe := MFSDelete(flh^^.Fvrn, flh^^.FdirID, flh^^.Fsh^^);
  64.             DisposHandle(handle(flh^^.Fsh));
  65.             DisposHandle(handle(flh));
  66.         end;
  67.     end;
  68.  
  69.     procedure FinishHQXLists;
  70.     begin
  71.         DeleteList(inlist, false);
  72.         DestroyList(inlist, false);
  73.         DeleteList(outlist, false);
  74.         DestroyList(outlist, false);
  75.     end;
  76.  
  77.     procedure StartList;
  78.         var
  79.             flh: fileListHandle;
  80.     begin
  81.         while not IsEmpty(inlist) do begin
  82.             DeleteHead(inlist, flh);
  83.             AddTail(outlist, flh);
  84.         end;
  85.         ReturnHead(outlist, outptr);
  86.     end;
  87.  
  88.     procedure FinishList (del: boolean);
  89.     begin
  90.         DeleteList(outlist, del);
  91.     end;
  92.  
  93.     function GetFileLength (vrn: integer; dirID: longInt; name: str63): longInt;
  94.         var
  95.             pb: HParamBlockRec;
  96.             oe: OSErr;
  97.     begin
  98.         with pb do begin
  99.             ioNamePtr := @name;
  100.             ioVRefNum := vrn;
  101.             ioDirID := dirID;
  102.             ioFVersNum := 0;
  103.             ioFDirIndex := 0;
  104.             oe := PBHGetFInfo(@pb, false);
  105.             if oe = noErr then
  106.                 GetFileLength := pb.ioFlLgLen
  107.             else
  108.                 GetFileLength := 0;
  109.         end;
  110.     end;
  111.  
  112.     procedure AddFile (vrn: integer; dirID: longInt; name: str63; folder: boolean; size: longInt);
  113.         var
  114.             flh, flh2: fileListHandle;
  115.             sh: stringHandle;
  116.             lp: listItem;
  117.             rel: integer;
  118.     begin
  119.         if size < 0 then
  120.             size := GetFileLength(vrn, dirID, name);
  121.         flh := fileListHandle(NewHandle(SizeOf(fileList)));
  122.         sh := NewString(name);
  123.         with flh^^ do begin
  124.             Fvrn := vrn;
  125.             FdirID := dirID;
  126.             Fsh := sh;
  127.             Ffolder := folder;
  128.             Fdel := false;
  129.             Fsize := size;
  130.         end;
  131.         size_in_lists := size_in_lists + size;
  132.         if IsEmpty(inlist) then
  133.             AddTail(inlist, flh)
  134.         else begin
  135.             ReturnTail(inlist, lp);
  136.             repeat
  137.                 MoveToPrev(lp);
  138.                 Fetch(lp, flh2);
  139.                 rel := RelString(flh2^^.Fsh^^, name, false, false);
  140.             until IsHead(lp) or (rel < 0); {Fsh<name}
  141.             if rel < 0 then
  142.                 AddAfter(lp, flh)
  143.             else
  144.                 AddBefore(lp, flh);
  145.         end;
  146.     end;
  147.  
  148.     procedure GetNextFile (var vrn: integer; var dirID: longInt; var name: str63; var folder: boolean);
  149.     begin
  150.         Fetch(outptr, outflh);
  151.         with outflh^^ do begin
  152.             vrn := Fvrn;
  153.             dirID := FdirID;
  154.             name := Fsh^^;
  155.             processing_name := name;
  156.             folder := Ffolder;
  157.         end;
  158.     end;
  159.  
  160.     procedure FinishFile (del: boolean);
  161.         var
  162.             flh: fileListHandle;
  163.     begin
  164.         outflh^^.Fdel := del;
  165.         MoveToNext(outptr);
  166.         processing_name := '';
  167.     end;
  168.  
  169.     function AnyFilesLeft: boolean;
  170.     begin
  171.         AnyFilesLeft := not IsTail(outptr);
  172.     end;
  173.  
  174.     function AnyInputFiles: boolean;
  175.     begin
  176.         AnyInputFiles := not IsEmpty(inlist);
  177.     end;
  178.  
  179. end.